home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Games: Greatest Hits 1996
/
Amiga Games: Greatest Hits 1996.iso
/
userbox
/
publicdomain
/
picturemenu
/
src
/
picturemenu.e
< prev
next >
Wrap
Text File
|
1996-04-09
|
7KB
|
320 lines
/* PictureMenu v1.3 */
/* by */
/* Pawel 2P Pijanowski */
MODULE 'intuition/intuition'
MODULE 'intuition/screens'
MODULE 'exec/ports'
MODULE 'exec/nodes'
MODULE 'exec/tasks'
MODULE 'graphics/text'
MODULE 'diskfont'
MODULE 'tools/file'
OBJECT pm
nextpm
adres_miwb
adres_itwb
mi_nextitem
mi_leftedge:INT
mi_topedge:INT
mi_width:INT
mi_height:INT
mi_flags:INT
mi_mutualexclude
mi_itemfill
mi_selectfill
mi_command:CHAR
mi_kludgefill00:CHAR
mi_subitem
mi_nextselect:INT
itwb_frontpen:CHAR
itwb_backpen:CHAR
itwb_drawmode:CHAR
itwb_kludgefill00:CHAR
itwb_leftedge:INT
itwb_topedge:INT
itwb_itextfont
itwb_itext
itwb_nexttext
itm1_frontpen:CHAR
itm1_backpen:CHAR
itm1_drawmode:CHAR
itm1_kludgefill00:CHAR
itm1_leftedge:INT
itm1_topedge:INT
itm1_itextfont
itm1_itext
itm1_nexttext
m1_char:CHAR
m1_zero:CHAR
itm2_frontpen:CHAR
itm2_backpen:CHAR
itm2_drawmode:CHAR
itm2_kludgefill00:CHAR
itm2_leftedge:INT
itm2_topedge:INT
itm2_itextfont
itm2_itext
itm2_nexttext
m2_char:CHAR
m2_zero:CHAR
ENDOBJECT
DEF pm_first
DEF pm_prev:PTR TO pm
DEF m_pm:PTR TO pm
DEF taskname[10]:STRING
DEF prefsname[30]:STRING
DEF m_textattr:textattr
DEF scr:PTR TO screen
DEF error=FALSE,errormes[30]:STRING
DEF m_textfont
DEF font[20]:STRING
DEF it_nic:intuitext
/*==================================================*/
PROC main()
DEF win:PTR TO window
DEF firsttime=FALSE
DEF it:PTR TO intuitext
DEF resetwbmi:PTR TO menuitem
DEF mysz
StrCopy(taskname,'Workbench',ALL)
UpperStr(taskname)
StrCopy(prefsname,'ENV:PicM_Workbench.prefs',ALL)
IF win:=OpenW(0,0,1,1,$200,256,'',NIL,1,NIL)
scr:=win.wscreen
CloseW(win)
REPEAT
IF firsttime THEN restore()
firsttime:=TRUE
resetwbmi:=modifymenu()
it:=resetwbmi.itemfill
it:=it.nexttext
REPEAT
Delay(50)
UNTIL it.itextfont<>m_textattr
mysz:=Mouse()
UNTIL error OR mysz=%1
restore()
ELSE
seterror('OpenWindow()')
ENDIF
IF error THEN WriteF('\nPictureMenu ERROR... \s\n',errormes) ELSE WriteF('PictureMenu: "bye bye !!"\n')
IF diskfontbase THEN CloseLibrary(diskfontbase)
ENDPROC
PROC modifymenu()
DEF fh
DEF resetwbmi:PTR TO menuitem
DEF mm:PTR TO menu
DEF firstmm
DEF mi:PTR TO menuitem
DEF txinmn[20]:STRING
DEF itemtext[20]:STRING
DEF delta,licznik,value
DEF wb_intuitext:PTR TO intuitext
DEF m1_intuitext:PTR TO intuitext
DEF m2_intuitext:PTR TO intuitext
DEF wb_textattr:PTR TO textattr
DEF m_image:PTR TO image
resetwbmi:=0
IF fh:=Open(prefsname,OLDFILE)
setfont(fh)
IF error=FALSE
mm:=setmenu(0)
IF mm
firstmm:=mm
pm_prev:=0
ReadStr(fh,txinmn)
WHILE mm<>0
delta:=0
licznik:=delta
mi:=mm.firstitem
WHILE mi<>0
IF (m_pm:=AllocMem(SIZEOF pm,2))
IF pm_prev=0 THEN pm_first:=m_pm ELSE pm_prev.nextpm:=m_pm
pm_prev:=m_pm
m_pm.nextpm:=0
m_pm.adres_miwb:=mi
m_pm.adres_itwb:=mi.itemfill
CopyMem(m_pm.adres_miwb,(m_pm+12),34)
CopyMem(m_pm.adres_itwb,(m_pm+46),20)
IF (mi.flags AND %10)
wb_intuitext:=mi.itemfill
StrCopy(itemtext,wb_intuitext.itext)
UpperStr(itemtext)
UpperStr(txinmn)
m1_intuitext:=m_pm+66
m2_intuitext:=m_pm+88
CopyMem(wb_intuitext,m1_intuitext,20)
CopyMem(wb_intuitext,m2_intuitext,20)
m1_intuitext.itextfont:=m_textattr
m2_intuitext.itextfont:=m_textattr
m1_intuitext.drawmode:=1
m1_intuitext.backpen:=1
m1_intuitext.frontpen:=0
m2_intuitext.drawmode:=1
m2_intuitext.backpen:=1
m2_intuitext.frontpen:=0
wb_intuitext.drawmode:=0
wb_intuitext.backpen:=0
wb_intuitext.frontpen:=1
wb_intuitext.nexttext:=m1_intuitext
m1_intuitext.nexttext:=it_nic
m2_intuitext.nexttext:=it_nic
mi.selectfill:=m2_intuitext
mi.itemfill:=wb_intuitext
mi.flags:=(mi.flags OR HIGHIMAGE) AND (Not(HIGHCOMP))
IF StrCmp(wb_intuitext.itext,'ResetWB',7) THEN resetwbmi:=mi
wb_intuitext.leftedge:=wb_intuitext.leftedge+m_textattr.ysize+16
mi.width:=mi.width+m_textattr.ysize+16
wb_textattr:=wb_intuitext.itextfont
IF m_textattr.ysize > wb_textattr.ysize
mi.height:=m_textattr.ysize+4
wb_intuitext.topedge:=(wb_intuitext.topedge+((mi.height-wb_textattr.ysize)/2))
mi.topedge:=((licznik*(mi.height+2))-delta)
ENDIF
m1_intuitext.topedge:=m1_intuitext.topedge+1
m2_intuitext.topedge:=m2_intuitext.topedge+1
IF (StrCmp(itemtext,txinmn,StrLen(txinmn))) AND (StrLen(txinmn)<>0)
value:=readvalue(fh)
m_pm.m1_char:=value
value:=readvalue(fh)
m_pm.m2_char:=value
ReadStr(fh,txinmn)
ReadStr(fh,txinmn)
ELSE
m_pm.m1_char:=32
m_pm.m2_char:=32
ENDIF
m_pm.m1_zero:=0
m_pm.m2_zero:=0
m1_intuitext.itext:=m_pm+86
m2_intuitext.itext:=m_pm+108
ELSE
mi.topedge:=(licznik*(m_textattr.ysize+6))-delta
m_image:=mi.itemfill
mi.width:=mi.width+m_textattr.ysize+16
m_image.leftedge:=m_image.leftedge+m_textattr.ysize+16
delta:=delta+m_textattr.ysize-m_image.height
ENDIF
INC licznik
mi:=mi.nextitem
ELSE
seterror('AllocMem()')
ENDIF
ENDWHILE
mm:=mm.nextmenu
ENDWHILE
CopyMem(resetwbmi.itemfill,it_nic,20)
it_nic.itext:=''
it_nic.nexttext:=0
setmenu(firstmm)
ELSE
seterror('I can`t find WB task.')
ENDIF
ENDIF
Close(fh)
ELSE
seterror('Open("ENV:PicM_Workbench.prefs")')
ENDIF
ENDPROC resetwbmi
PROC restore()
DEF pm_next
DEF mm
mm:=setmenu(0)
IF m_textfont THEN CloseFont(m_textfont)
m_pm:=pm_first
WHILE m_pm<>0
CopyMem(m_pm+16,m_pm.adres_miwb+4,30)
CopyMem(m_pm+46,m_pm.adres_itwb,20)
pm_next:=m_pm.nextpm
FreeMem(m_pm,SIZEOF pm)
m_pm:=pm_next
ENDWHILE
IF mm THEN setmenu(mm)
pm_first:=0
ENDPROC
/*===================================================*/
PROC seterror(tekst)
error:=TRUE
StrCopy(errormes,tekst,ALL)
ENDPROC
PROC setfont(fh)
DEF sizestr[3]:STRING
IF ReadStr(fh,font)=-1 THEN seterror('font')
IF ReadStr(fh,sizestr)=-1 THEN seterror('size font')
m_textattr.name:=font
m_textattr.ysize:=Val(sizestr)
m_textattr.style:=0
m_textattr.flags:=FPF_DESIGNED
ReadStr(fh,sizestr)
IF diskfontbase=0 THEN diskfontbase:=OpenLibrary('diskfont.library',NIL)
IF diskfontbase
m_textfont:=OpenDiskFont(m_textattr)
IF m_textfont=0
seterror('OpenDiskFont()')
ENDIF
ELSE
seterror('OpenLibrary("diskfont.library")')
ENDIF
ENDPROC
PROC setmenu(mmm)
DEF actwin:PTR TO window
DEF actnodename[10]:STRING
DEF mojmsgport:PTR TO mp
DEF mojnode:PTR TO ln
DEF mojtask:PTR TO tc
DEF actmenu:PTR TO menu
actmenu:=mmm
actwin:=scr.firstwindow
WHILE (actwin<>0)
mojmsgport:=actwin.userport
mojtask:=mojmsgport.sigtask
mojnode:=mojtask.ln
StrCopy(actnodename,mojnode.name,ALL)
UpperStr(actnodename)
IF StrCmp(actnodename,taskname,StrLen(taskname))
IF mmm<>0
SetMenuStrip(actwin,mmm)
ELSE
actmenu:=actwin.menustrip
ClearMenuStrip(actwin)
ENDIF
ENDIF
actwin:=actwin.nextwindow
ENDWHILE
ENDPROC actmenu
PROC readvalue(filehandle)
DEF m_string[20]:STRING
DEF value
IF ReadStr(filehandle,m_string)=-1 THEN value:=32
value:=Val(m_string)
ENDPROC value